00100	(DE TRANSFORM (E R DONE) (COND ((MEMBER E DONE) E)
00200	(T ((LAMBDA (W) (COND ((EQ W E) (COND ((ATOM E) E) (T ((LAMBDA (X Y) (COND
00300	((AND (EQ X (CAR E)) (EQ Y (CDR E))) (SIDE E
00400	(SETQ DONE (CONS E DONE)))) (T (TRANSFORM (CONS X Y) R DONE))))
00500	(TRANSFORM (CAR E) R DONE) (TRANSFORM (CDR E) R DONE)))))
00600	(T (TRANSFORM W R DONE)))) (TRANSA E R)))))
00700	
00800	(DE TRANSA (E R) (COND ((NULL R) E) (T 
00900	((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R))) (T W)))
01000	(TRANSB E (CAR R))))))
01100	
01200	(DE TRANSB (E RULE) ((LAMBDA (W) (COND ((OR (EQ W (QUOTE NO))
01250	(NOT (EVAL (CADR RULE) W))) E)
01300	((CADDR RULE) (SUBLIS (CADDDR RULE) W))
01350	(T (EVAL (CADDDR RULE) W)))) (INST E (CAR RULE) NIL)))
01400	
01500	(DE SIDE (X Y) X)
01600	
01700	(SETQ R1 (QUOTE (
01800	((PLUS.X) (MEMBER 0 X) NIL (CONS (QUOTE PLUS) (DZ X)))
01900	((TIMES.X) (MEMBER 0 X) T 0)
02000	((TIMES.X) (MEMBER 1 X) NIL (CONS (QUOTE TIMES) (D1 X)))
02100	((PLUS) T T 0)
02200	((PLUS X) T T X)
02300	((TIMES) T T 1)
02400	((TIMES X) T T X)
02500	)))
02600	
02700	(DE DZ (U) (COND ((NULL U) NIL) ((EQ (CAR U) 0) (DZ (CDR U)))
02800	((AND (NOT (ATOM (CAR U))) (EQ (CAAR U) (QUOTE PLUS)))
02900	(APPEND (CDAR U) (DZ (CDR U)))) (T (CONS (CAR U)
03000	(DZ (CDR U))))))
03100	
03200	(DE D1 (U) (COND ((NULL U) NIL) ((EQ (CAR U) 1) (D1 (CDR U)))
03300	((AND (NOT (ATOM (CAR U))) (EQ (CAAR U) (QUOTE TIMES)))
03400	(APPEND (CDAR U) (D1 (CDR U)))) (T (CONS (CAR U)
03500	(D1 (CDR U))))))